home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / UTIL / Alpha 6.5.sit / Tcl / Modes / javaMode.tcl < prev    next >
Text File  |  1996-08-18  |  7KB  |  171 lines
  1.  
  2. if {$startingUp} {
  3.     #================================================================================
  4.     addMode Java javaMenu {*.java *.j} javaMenu
  5.     set javaMenu         "･140"
  6.     addMenu javaMenu
  7.     set modeMenus(Java)                {javaMenu}
  8.     return
  9. }
  10.  
  11.  
  12.  
  13. newModeVar Java elecColon {1} 1
  14. newModeVar Java elecRBrace {1} 1
  15. newModeVar Java leftFillColumn {3} 0
  16. newModeVar Java prefixString {//} 0 
  17. newModeVar Java electricSemi {1} 1
  18. newModeVar Java elecLBrace {1} 1
  19. newModeVar Java elecElse {1} 1
  20. newModeVar Java wordWrap {0} 1
  21. newModeVar Java funcExpr {^[^ ¥t¥(#¥r/@].*¥(.*¥)$} 0
  22. newModeVar Java parseExpr {¥b([_:¥w]+)¥s*¥(} 0
  23. newModeVar Java wordBreak {¥w+} 0
  24. newModeVar Java wordBreakPreface {¥W} 0
  25. newModeVar Java electricTab {0} 1
  26. newModeVar Java autoMark    0    1
  27. newModeVar Java stringColor        green    0
  28. newModeVar Java commentColor    red        0
  29. newModeVar Java keywordColor    blue    0
  30.  
  31. regModeKeywords  -e {//} -b {/*} {*/} -c $JavamodeVars(commentColor) -k $JavamodeVars(keywordColor)  -s $JavamodeVars(stringColor) Java {
  32.     abstract boolean break byte byvalue case catch char class const continue 
  33.     default do double else extends false final finally float for goto if 
  34.     implements import instanceof int interface long native new null package 
  35.     private protected public return short static super switch synchronized this 
  36.     threadsafe throw transient true try void while }
  37.  
  38.  
  39.  
  40. proc javaMenu {} {}
  41.  
  42. menu -n $javaMenu -p javaMenuProc {
  43.     "/S<U<OswitchToCompiler"
  44.     "(-"
  45.     "/K<U<OcompileFile"
  46. }
  47.  
  48.  
  49. proc javaMenuProc {menu item} {
  50.     switch $item {
  51.         switchToCompiler {launchForeAppl Javc}
  52.         compileFile {launchForeAppl Javc; sendOpenEvent -n 'Javc' [car [winNames -f]]}
  53.     }
  54. }
  55.  
  56.  
  57. # My version of JavaMarkFile. First revision, April 1996.
  58. # Jim Menard, jimm@io.com
  59. proc JavaMarkFile {} {
  60.         # Sorry, but globals are a lot easier than using "upvar" in subroutines
  61.         global markArray
  62.         global classStartPositions
  63.         global classNames
  64.  
  65.         unset markArray
  66.  
  67.         # Look for class definitions first
  68.         set markExpr {^[ ¥t]*([A-Za-z_][A-Za-z0-9_]*[ ¥t]+)*class[ ¥t]+[A-Za-z_][A-Za-z0-9_]*[ ¥t¥r]([A-Za-z_][A-Za-z0-9_.]*[ ¥t]+)*¥{}
  69.         set wordExpr {class[ ¥t]+([A-Za-z_][A-Za-z0-9_]*)}
  70.         set commands {
  71.                 set markArray([concat $word "class"]) $markPos
  72.                 # Remember mark position and name separately so we can call
  73.                 # getClassFromPos() later.
  74.                 lappend classStartPositions $markPos
  75.                 lappend classNames $word
  76.         }
  77.         searchAndDestroy $markExpr $wordExpr $commands 0
  78.  
  79.         # The following regular expression is overly restrictive. After the open
  80.         # paren, I disallow semicolons. That avoids finding lines like
  81.         #       throw new FooException(arg);
  82.         # which is good, but unfortunately also avoids finding lines like
  83.         #       public int foo(arg) // comment with semi;
  84.         #
  85.         # It doesn't find constructors without a "public", "private", or other phrase
  86.         # before the method name since it requires at least one word before the
  87.         # method name. They are special-cased below. I did that so function calls,
  88.         # "if" statements, and the like wouldn't be found.
  89.         set markExpr {^[ ¥t]*([A-Za-z_][A-Za-z0-9_]*[ ¥t]+)+[A-Za-z_][A-Za-z0-9_]*[ ¥t¥r]*¥([^;]+$}
  90.         set wordExpr {([A-Za-z_][A-Za-z0-9_]*)[ ¥t]*¥(}
  91.         set commands {
  92.                 if {$className == $word} {
  93.                         set markArray([concat $className "constructor"]) $markPos
  94.                 } else {
  95.                         set markArray($className::$word) $markPos
  96.                 }
  97.         }
  98.         searchAndDestroy $markExpr $wordExpr $commands 1
  99.  
  100.         # One more time; let's go back for constructors with no modifiers.
  101.         set markExpr {^[ ¥t]*[A-Z][A-Za-z0-9_]*[ ¥t¥r]*¥([^;]+$}
  102.         set wordExpr {([A-Z][A-Za-z0-9_]*)[ ¥t]*¥(}
  103.         set commands {
  104.                 if {$className == $word} {
  105.                         set markArray([concat $className "constructor"]) [lineStart [expr $start - 1]]
  106.                 }
  107.         }
  108.         searchAndDestroy $markExpr $wordExpr $commands 1
  109.  
  110.         if {[info exists markArray]} {
  111.                 foreach f [lsort -ignore [array names markArray]] {
  112.                         set next [nextLineStart $markArray($f)]
  113.                         if {[string length $f] > 35} { set f "[string range $f 0 31]..." }
  114.                         setNamedMark "${f}" "$markArray($f)" $next $next
  115.                 }
  116.         }
  117. }
  118.  
  119. # Start at top of file and find text that matches markExpr. Clean it up and
  120. # use wordExpr to find the word we want. Execute commands.
  121. proc searchAndDestroy {markExpr wordExpr commands needClassName} {
  122.         global markArray
  123.         global classStartPositions
  124.         global classNames
  125.  
  126.         set pos 0
  127.         while {![catch {search -s -f 1 -r 1 -m 0 -i 0 "$markExpr" $pos} res]} {
  128.                 set start [lindex $res 0]
  129.                 set end [expr [lindex $res 1] + 1]
  130.                 set thistext [getText $start $end]
  131.                 if {$needClassName} {
  132.                         set className [getClassFromPos $start $classStartPositions $classNames]
  133.                 }
  134.                 # regexp doesn't like carriage returns or tabs
  135.                 regsub -all "¥r" $thistext " " thistext
  136.                 regsub -all "¥t" $thistext " " thistext
  137.                 # If the open paren was the last character on the line, the selected text
  138.                 # included the last carriage return as well. Trim this off now that it is
  139.                 # changed into a space.
  140.                 set thistext [string trimright $thistext]
  141.                 if {[regexp $wordExpr $thistext dummy word]} {
  142.                         set markPos [lineStart [expr $start - 1]]
  143.                         eval $commands
  144.                 }
  145.                 set pos $end
  146.         }
  147. }
  148.  
  149. # Given a file position, find the class definition in which it resides.
  150. # There's got to be an easier way than passing two separate lists. I tried
  151. # fooling around with markArray(), but don't know Tcl well enough to use
  152. # it instead.
  153. proc getClassFromPos {pos classStartPositions classNames} {
  154.         set nClasses [llength $classStartPositions]
  155.         for {set i [expr $nClasses - 1]} {$i >= 0} {set i [expr $i - 1]} {
  156.                 if {[lindex $classStartPositions $i] <= $pos} {
  157.                         return [lindex $classNames $i]
  158.                 }
  159.         }
  160.         return ""
  161. }
  162.  
  163.  
  164. bind '¥{' <s> electricLeft        Java
  165. bind '¥;' electricSemi            Java
  166. bind '¥}' <s> electricRight    Java
  167. bind '¥;' <z> ordSemi            Java
  168.  
  169. insertMenu $javaMenu
  170.  
  171.